home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / PNL Libraries / MyCollections.p < prev    next >
Encoding:
Text File  |  1994-01-19  |  20.3 KB  |  823 lines  |  [TEXT/PJMM]
  1. unit MyCollections;
  2.  
  3. interface
  4.  
  5.     const
  6.         no_tag = 0;
  7.  
  8.     type
  9.         PermuteArray = array[1..8000] of integer;
  10.         PermuteArrayPtr = ^PermuteArray;
  11.  
  12.     type
  13.         tagType = longInt;
  14.         indexType = longInt;
  15.         collection = object
  16.                 error: OSErr; { PUBLIC }
  17.                 safeget: boolean; { PUBLIC }
  18.                 testheap: boolean; { PUBLIC }
  19.  
  20.                 data: handle; { PRIVATE }
  21.                 size: longInt; { PRIVATE }
  22.                 cnt: indexType; { PRIVATE }
  23.                 fixed, tagged: boolean; { PRIVATE }
  24.                 lensize, tagsize: longInt; { PRIVATE }
  25.                 searchindex: indexType; { PRIVATE }
  26.                 searchtag: tagType; { PRIVATE }
  27.                 cacheoffset: longInt; { PRIVATE }
  28.                 cachelen: longInt; { PRIVATE }
  29.                 cacheindex: indexType; { PRIVATE }
  30.  
  31.                 procedure Create (siz: longInt; fix, tag: boolean);
  32.                 procedure CreateFromHandle (d: handle);
  33.                 procedure Destroy;
  34.                 procedure SetDataHandle (d: handle);
  35.                 function GetDataHandle: handle;
  36.                 procedure Reset;
  37.  
  38.                 function Count: indexType;
  39.  
  40.                 function GetTag (index: indexType): tagType;
  41.                 function GetIndex (tag: tagType): indexType;
  42.  
  43.                 procedure SetTag (index: indexType; tag: tagType);
  44.  
  45.                 function Exists (index: indexType): boolean;
  46.                 function ExistsTag (tag: univ tagType): boolean;
  47.  
  48.                 function Info (index: indexType; var len: longInt): boolean;
  49.                 function InfoTag (tag: univ tagType; var len: longInt): boolean;
  50.  
  51.                 procedure Delete (index: indexType);
  52.                 procedure DeleteTag (tag: univ tagType);
  53.  
  54.                 procedure InsertBefore (index: indexType);
  55.  
  56.                 procedure Permute (map: PermuteArrayPtr); { WARNING: Destroys permute array data }
  57.  
  58.                 procedure AddBoolean (b: boolean);
  59.                 procedure AddTagBoolean (tag: univ tagType; b: boolean);
  60.                 procedure AddLong (n: univ longInt);
  61.                 procedure AddTagLong (tag: univ tagType; n: univ longInt);
  62.                 procedure AddString (s: str255);
  63.                 procedure AddTagString (tag: univ tagType; s: str255);
  64.                 procedure AddData (p: ptr; len: longInt);
  65.                 procedure AddTagData (tag: univ tagType; p: ptr; len: longInt);
  66.                 procedure AddItem (p: ptr);
  67.                 procedure AddTagItem (tag: univ tagType; p: ptr);
  68.  
  69.                 procedure SetBoolean (index: indexType; b: boolean);
  70.                 procedure SetTagBoolean (tag: univ tagType; b: boolean);
  71.                 procedure SetLong (index: indexType; n: univ longInt);
  72.                 procedure SetTagLong (tag: univ tagType; n: univ longInt);
  73.                 procedure SetString (index: indexType; s: str255);
  74.                 procedure SetTagString (tag: univ tagType; s: str255);
  75.                 procedure SetData (index: indexType; p: ptr; len: longInt);
  76.                 procedure SetTagData (tag: univ tagType; p: ptr; len: longInt);
  77.                 procedure SetItem (index: indexType; p: ptr);
  78.                 procedure SetTagItem (tag: univ tagType; p: ptr);
  79.  
  80.                 function GetBoolean (index: indexType): boolean;
  81.                 function GetTagBoolean (tag: univ tagType): boolean;
  82.                 procedure GetLong (index: indexType; var l: univ longInt);
  83.                 procedure GetTagLong (tag: univ tagType; var l: univ longInt);
  84.                 function GetString (index: indexType): str255;
  85.                 function GetTagString (tag: univ tagType): str255;
  86.                 procedure GetData (index: indexType; p: ptr; len: longInt);
  87.                 procedure GetTagData (tag: univ tagType; p: ptr; len: longInt);
  88.                 procedure GetItem (index: indexType; p: ptr);
  89.                 procedure GetTagItem (tag: univ tagType; p: ptr);
  90.  
  91.                 procedure InvalidateCache;
  92.                 function GetOffset (index: indexType; var offset: longInt; var len: longInt): boolean; { PRIVATE }
  93.                 function GetTagOffset (tag: univ tagType; var offset: longInt; var len: longInt; var index: indexType; test: boolean): boolean; { PRIVATE }
  94.                 procedure AddChunk (tag: tagType; p: ptr; len: longInt); { PRIVATE }
  95.                 procedure SetChunk (offset, l: longInt; tag: tagType; p: ptr; len: longInt); { PRIVATE }
  96.                 procedure SetChunkIndex (index: indexType; p: ptr; len: longInt); { PRIVATE }
  97.                 procedure SetChunkTag (tag: tagType; p: ptr; len: longInt); { PRIVATE }
  98.                 procedure GetChunkIndex (index: indexType; len: longInt; p: ptr); { PRIVATE }
  99.                 procedure GetChunkTag (tag: tagType; len: longInt; p: ptr); { PRIVATE }
  100.             end;
  101.  
  102.     procedure HackUpdateHandleToCollection (data: handle);
  103.  
  104. implementation
  105.  
  106.     uses
  107.         MyAssertions, MyUtils, MyTypes;
  108.  
  109. { Format is saved in prefs files, so it must not change! }
  110.  
  111.     const
  112.         lsize = 4;
  113.         magic_version = $12345678;
  114.         fixed_bit = 16;
  115.         tagged_bit = 0;
  116.         safeget_bit = 1;
  117.  
  118.     type
  119.         header = record
  120.                 version: longInt;
  121.                 size: longInt;
  122.                 cnt: indexType;
  123.                 flags: longInt;
  124.                 space: longInt;
  125.             end;
  126.         headerPtr = ^header;
  127.         headerHandle = ^headerPtr;
  128.  
  129. { Data format: }
  130. { header}
  131. { [tag (lsize)] [length (lsize)] data }
  132.  
  133.     function LongAtPtr (p: univ ptr): longInt;
  134.     inline
  135.         $205F, $224F, $12D8, $12D8, $12D8, $12D8;
  136. { move.l (sp)+,a0 move.l sp,a1, 4*move.b (a0)+,(a1) }
  137.  
  138.     procedure HackUpdateHandleToCollection (data: handle);
  139.         var
  140.             h: header;
  141.             pos: longInt;
  142.             size: longInt;
  143.     begin
  144.         if (GetHandleSize(data) < SizeOf(header)) | (headerHandle(data)^^.version <> magic_version) then begin
  145.             h.version := magic_version;
  146.             h.size := -1;
  147.             h.flags := 0;
  148.             BSET(h.flags, tagged_bit);
  149.             BSET(h.flags, safeget_bit);
  150.             h.space := 0;
  151.             h.cnt := 0;
  152.             pos := 0;
  153.             while (pos >= 0) & (pos <= GetHandleSize(data) - 8) do begin
  154.                 h.cnt := h.cnt + 1;
  155.                 size := LongAtPtr(ptr(ord(data^) + lsize));
  156.                 if (size < 0) | (size > 1000) then
  157.                     pos := -1
  158.                 else
  159.                     pos := pos + 8 + size;
  160.             end;
  161.             if pos <> GetHandleSize(data) then begin
  162.                 SetHandleSize(data, 0);
  163.                 h.cnt := 0;
  164.             end;
  165.             pos := Munger(data, 0, nil, 0, @h, SizeOf(h));
  166.         end;
  167.     end;
  168.  
  169.     procedure collection.Create (siz: longInt; fix, tag: boolean);
  170.     begin
  171.         data := NewHandle(SizeOf(header));
  172.         size := siz;
  173.         fixed := fix;
  174.         tagged := tag;
  175.         safeget := false;
  176.         testheap := false;
  177.         lensize := lsize * ord(not fixed);
  178.         tagsize := lsize * ord(tagged);
  179.         Reset;
  180.     end;
  181.  
  182.     procedure collection.Destroy;
  183.     begin
  184.         DisposeHandle(data);
  185.         dispose(self);
  186.     end;
  187.  
  188.     function collection.GetDataHandle: handle;
  189.         var
  190.             flags: longInt;
  191.     begin
  192.         headerHandle(data)^^.version := magic_version;
  193.         headerHandle(data)^^.size := size;
  194.         headerHandle(data)^^.cnt := cnt;
  195.         flags := 0;
  196.         if fixed then
  197.             BSET(flags, fixed_bit);
  198.         if tagged then
  199.             BSET(flags, tagged_bit);
  200.         if safeget then
  201.             BSET(flags, safeget_bit);
  202.         headerHandle(data)^^.flags := flags;
  203.         headerHandle(data)^^.space := 0;
  204.         GetDataHandle := data;
  205.     end;
  206.  
  207.     procedure collection.SetDataHandle (d: handle);
  208.         var
  209.             flags: longInt;
  210.     begin
  211.         if headerHandle(d)^^.version = magic_version then begin
  212.             DisposeHandle(data);
  213.             data := d;
  214.             error := noErr;
  215.             size := headerHandle(data)^^.size;
  216.             cnt := headerHandle(data)^^.cnt;
  217.             flags := headerHandle(data)^^.flags;
  218.             fixed := BTST(flags, fixed_bit);
  219.             tagged := BTST(flags, tagged_bit);
  220.             safeget := BTST(flags, safeget_bit);
  221.             lensize := lsize * ord(not fixed);
  222.             tagsize := lsize * ord(tagged);
  223.             InvalidateCache;
  224.         end
  225.         else begin
  226.             Reset;
  227.             error := -1;
  228.         end;
  229.     end;
  230.  
  231.     procedure collection.CreateFromHandle (d: handle);
  232.     begin
  233.         data := NewHandle(SizeOf(header));
  234.         SetDataHandle(d);
  235.     end;
  236.  
  237.     procedure collection.Reset;
  238.     begin
  239.         error := noErr;
  240.         cnt := 0;
  241.         SetHandleSize(data, SizeOf(header));
  242.         InvalidateCache;
  243.     end;
  244.  
  245.     procedure collection.InvalidateCache;
  246.     begin
  247.         cacheoffset := -1;
  248.     end;
  249.  
  250.     procedure collection.Permute (map: PermuteArrayPtr);
  251.         type
  252.             LongArray = array[1..8000] of longInt;
  253.             LongArrayPtr = ^LongArray;
  254.         var
  255.             i, j, k: integer;
  256.             offset, src, len, handlesize, result: longInt;
  257.             dummy: boolean;
  258.             newdata: handle;
  259.             offsetptr: LongArrayPtr;
  260.             err: OSErr;
  261.     begin
  262.         handlesize := GetHandleSize(data);
  263.         newdata := TempNewHandle(handlesize, err);
  264.         if newdata = nil then
  265.             newdata := NewHandle(handlesize);
  266.         offsetptr := nil;
  267.         if newdata <> nil then begin
  268.             offsetptr := LongArrayPtr(NewPtr(longInt(cnt) * 4));
  269.         end;
  270.         if offsetptr <> nil then begin
  271.             offset := SizeOf(header) + tagsize;
  272.             for i := 1 to cnt do begin
  273.                 offsetptr^[i] := offset - tagsize;
  274.                 if fixed then begin
  275.                     offset := offset + size + tagsize;
  276.                 end
  277.                 else begin
  278.                     offset := offset + lsize + LongAtPtr(ptr(ord(data^) + offset)) + tagsize; { point to next length }
  279.                 end;
  280.             end;
  281.             offset := SizeOf(header);
  282.             len := size + tagsize + lensize;
  283.             for i := 1 to cnt do begin
  284.                 src := offsetptr^[map^[i]];
  285.                 if not fixed then begin
  286.                     len := tagsize + LongAtPtr(ptr(ord(data^) + src + tagsize)) + lensize;
  287.                 end;
  288.                 BlockMove(ptr(ord(data^) + src), ptr(ord(newdata^) + offset), len);
  289.                 offset := offset + len;
  290.             end;
  291.             Assert(offset = handlesize);
  292.             BlockMove(newdata^, data^, handlesize);
  293.             DisposePtr(ptr(offsetptr));
  294.             DisposeHandle(newdata);
  295.         end
  296.         else begin
  297.             DisposeHandle(newdata); { nil safe }
  298.             for i := 1 to cnt do begin
  299.                 k := map^[i];
  300.                 cacheoffset := -1;
  301.                 dummy := GetOffset(k, offset, len);
  302.                 Assert(dummy);
  303.                 offset := offset - tagsize - lensize;
  304.                 len := len + tagsize + lensize;
  305.                 SetHandleSize(data, handlesize + len);
  306.                 Assert(MemError = noErr);
  307.                 HLock(data);
  308.                 BlockMove(ptr(ord(data^) + offset), ptr(ord(data^) + handlesize), len);
  309.                 HUnlock(data);
  310.                 result := Munger(data, offset, nil, len, @data, 0);
  311.                 Assert(result >= 0);
  312.                 cacheoffset := -1;
  313.                 for j := 1 to cnt do begin
  314.                     if map^[j] > k then begin
  315.                         map^[j] := map^[j] - 1;
  316.                     end;
  317.                 end;
  318.             end;
  319.         end;
  320.         InvalidateCache;
  321.     end;
  322.  
  323.     function collection.GetOffset (index: indexType; var offset: longInt; var len: longInt): boolean; { PRIVATE }
  324.         var
  325.             valid: boolean;
  326.             handlesize: longInt;
  327.             i: indexType;
  328.     begin
  329.         if testheap then
  330.             DebugStr('GetOffset;hc;g');
  331.         valid := (0 < index) & (index <= cnt);
  332.         if valid then begin
  333.             if fixed then begin
  334.                 len := size;
  335.                 offset := SizeOf(header) + (index - 1) * (size + tagsize) + tagsize;
  336.             end
  337.             else begin
  338.                 if (cacheoffset > 0) & (searchindex > 0) & (searchindex <= index) then begin
  339.                     offset := cacheoffset - lsize;
  340.                     i := searchindex;
  341.                 end
  342.                 else begin
  343.                     offset := SizeOf(header) + tagsize; { point to first length }
  344.                     i := 1;
  345.                 end;
  346.                 while (i < index) do begin
  347.                     offset := offset + lsize + LongAtPtr(ptr(ord(data^) + offset)) + tagsize; { point to next length }
  348.                     i := i + 1;
  349.                 end;
  350.                 len := LongAtPtr(ptr(ord(data^) + offset));
  351.                 offset := offset + lsize; { point to data }
  352.             end;
  353.             cacheoffset := offset;
  354.             cachelen := len;
  355.             searchindex := index;
  356.         end
  357.         else begin
  358.             Assert(false);
  359.             InvalidateCache;
  360.         end;
  361.         GetOffset := valid;
  362.     end;
  363.  
  364.     function collection.GetTagOffset (tag: univ tagType; var offset: longInt; var len: longInt; var index: indexType; test: boolean): boolean; { PRIVATE }
  365.         var
  366.             valid: boolean;
  367.             t: tagType;
  368.             handlesize: longInt;
  369.     begin
  370.         if testheap then
  371.             DebugStr('GetTagOffset;hc;g');
  372.         valid := false;
  373.         if tagged then begin
  374.             if (cacheoffset > 0) & (searchindex < 0) & (searchtag = tag) then begin
  375.                 offset := cacheoffset;
  376.                 len := cachelen;
  377.                 index := cacheindex;
  378.                 valid := true;
  379.             end
  380.             else begin
  381.                 len := size;
  382.                 index := 0;
  383.                 offset := SizeOf(header); { point to first tag }
  384.                 handlesize := GetHandleSize(data);
  385.                 while (not valid) & (index < cnt) do begin
  386.                     Assert((0 < offset) & (offset < handlesize));
  387.                     t := LongAtPtr(ptr(ord(data^) + offset));
  388.                     if not fixed then
  389.                         len := LongAtPtr(ptr(ord(data^) + offset + tagsize));
  390.                     offset := offset + tagsize + lensize + len; { point to next tag }
  391.                     index := index + 1;
  392.                     valid := t = tag;
  393.                 end;
  394.                 offset := offset - len; { point to data }
  395.             end;
  396.         end;
  397.         if not test then
  398.             Assert(valid);
  399.         if valid then begin
  400.             cacheoffset := offset;
  401.             cachelen := len;
  402.             cacheindex := index;
  403.             searchindex := -1;
  404.             searchtag := tag;
  405.         end
  406.         else begin
  407.             InvalidateCache;
  408.         end;
  409.         GetTagOffset := valid;
  410.     end;
  411.  
  412.     function collection.Count: indexType;
  413.     begin
  414.         Count := cnt;
  415.     end;
  416.  
  417.     function collection.GetTag (index: indexType): tagType;
  418.         var
  419.             offset, len: longInt;
  420.     begin
  421.         GetTag := no_tag;
  422.         Assert(tagged);
  423.         if GetOffset(index, offset, len) then begin
  424.             GetTag := LongAtPtr(ptr(ord(data^) + offset - lensize - tagsize));
  425.         end;
  426.     end;
  427.  
  428.     procedure collection.SetTag (index: indexType; tag: tagType);
  429.         var
  430.             offset, len: longInt;
  431.     begin
  432.         Assert(tagged);
  433.         if GetOffset(index, offset, len) then begin
  434.             BlockMove(@tag, ptr(ord(data^) + offset - lensize - tagsize), tagsize);
  435.         end;
  436.     end;
  437.  
  438.     function collection.GetIndex (tag: tagType): indexType;
  439.         var
  440.             offset, len: longInt;
  441.             index: indexType;
  442.     begin
  443.         GetIndex := 0;
  444.         if GetTagOffset(tag, offset, len, index, true) then begin
  445.             GetIndex := index;
  446.         end;
  447.     end;
  448.  
  449.     function collection.Info (index: indexType; var len: longInt): boolean;
  450.         var
  451.             offset: longInt;
  452.     begin
  453.         Info := (1 <= index) & (index <= cnt) & GetOffset(index, offset, len);
  454.     end;
  455.  
  456.     function collection.InfoTag (tag: univ tagType; var len: longInt): boolean;
  457.         var
  458.             offset: longInt;
  459.             index: indexType;
  460.     begin
  461.         InfoTag := GetTagOffset(tag, offset, len, index, true);
  462.     end;
  463.  
  464.     function collection.Exists (index: indexType): boolean;
  465.         var
  466.             len: longInt;
  467.     begin
  468.         Exists := Info(index, len);
  469.     end;
  470.  
  471.     function collection.ExistsTag (tag: univ tagType): boolean;
  472.         var
  473.             len: longInt;
  474.     begin
  475.         ExistsTag := InfoTag(tag, len);
  476.     end;
  477.  
  478.     procedure collection.Delete (index: indexType);
  479.         var
  480.             offset, len: longInt;
  481.     begin
  482.         if GetOffset(index, offset, len) then begin
  483.             offset := Munger(data, offset - tagsize - lensize, nil, tagsize + lensize + len, @offset, 0);
  484.             cnt := cnt - 1;
  485.             InvalidateCache;
  486.         end;
  487.     end;
  488.  
  489.     procedure collection.DeleteTag (tag: univ tagType);
  490.         var
  491.             offset, len: longInt;
  492.             index: indexType;
  493.     begin
  494.         if GetTagOffset(tag, offset, len, index, false) then begin
  495.             offset := Munger(data, offset - tagsize - lensize, nil, tagsize + lensize + len, @offset, 0);
  496.             cnt := cnt - 1;
  497.             InvalidateCache;
  498.         end;
  499.     end;
  500.  
  501.     procedure collection.AddChunk (tag: tagType; p: ptr; len: longInt);
  502.         var
  503.             oe: OSErr;
  504.             orgsize: longInt;
  505.     begin
  506.         if testheap then
  507.             DebugStr('AddChunk Enter;hc;g');
  508.         if error = noErr then begin
  509.             orgsize := GetHandleSize(data);
  510.             SetHandleSize(data, orgsize + tagsize + lensize + len);
  511.             if MemError = noErr then begin
  512.                 if tagged then begin
  513.                     BlockMove(@tag, ptr(ord(data^) + orgsize), lsize);
  514.                     orgsize := orgsize + lsize;
  515.                 end
  516.                 else begin
  517.                     Assert(tag = no_tag);
  518.                 end;
  519.                 if not fixed then begin
  520.                     BlockMove(@len, ptr(ord(data^) + orgsize), lsize);
  521.                     orgsize := orgsize + lsize;
  522.                 end
  523.                 else begin
  524.                     Assert(len = size);
  525.                 end;
  526.                 BlockMove(p, ptr(ord(data^) + orgsize), len);
  527.                 cnt := cnt + 1;
  528.             end;
  529.         end;
  530.         if testheap then
  531.             DebugStr('AddChunk Exit;hc;g');
  532.     end;
  533.  
  534.     procedure collection.InsertBefore (index: indexType);
  535.         var
  536.             offset, len, oe: longInt;
  537.             t: tagType;
  538.     begin
  539.         t := no_tag;
  540.         if index = Count + 1 then begin
  541.             if fixed then begin
  542.                 AddChunk(t, @index, size);
  543.             end
  544.             else begin
  545.                 AddChunk(t, @index, 0);
  546.             end;
  547.         end
  548.         else begin
  549.             if GetOffset(index, offset, len) then begin
  550.                 offset := offset - lensize - tagsize;
  551.                 if tagged then begin
  552.                     oe := Munger(data, offset, nil, 0, @t, tagsize);
  553.                     offset := offset + tagsize;
  554.                 end;
  555.                 if fixed then begin
  556.                     oe := Munger(data, offset, nil, 0, @index, size);
  557.                 end
  558.                 else begin
  559.                     len := 0;
  560.                     oe := Munger(data, offset, nil, 0, @len, lensize);
  561.                 end;
  562.                 cnt := cnt + 1;
  563.                 InvalidateCache;
  564.             end;
  565.         end;
  566.     end;
  567.  
  568.     procedure collection.SetChunk (offset, l: longInt; tag: tagType; p: ptr; len: longInt);
  569.     begin
  570.         if tagged then begin
  571.             BlockMove(@tag, ptr(ord(data^) + offset - lensize - tagsize), tagsize);
  572.         end
  573.         else begin
  574.             Assert(tag = no_tag);
  575.         end;
  576.         if fixed then
  577.             Assert(len = size);
  578.         if l = len then begin
  579.             BlockMove(p, ptr(ord(data^) + offset), len);
  580.         end
  581.         else begin
  582.             BlockMove(@len, ptr(ord(data^) + offset - lensize), lensize);
  583.             offset := Munger(data, offset, nil, l, p, len);
  584.         end;
  585.         InvalidateCache;
  586.     end;
  587.  
  588.     procedure collection.SetChunkIndex (index: indexType; p: ptr; len: longInt);
  589.         var
  590.             offset, l: longInt;
  591.     begin
  592.         if GetOffset(index, offset, l) then begin
  593.             SetChunk(offset, l, no_tag, p, len);
  594.         end;
  595.     end;
  596.  
  597.     procedure collection.SetChunkTag (tag: tagType; p: ptr; len: longInt);
  598.         var
  599.             offset, l: longInt;
  600.             index: indexType;
  601.     begin
  602.         if GetTagOffset(tag, offset, l, index, true) then begin
  603.             SetChunk(offset, l, tag, p, len);
  604.         end
  605.         else begin
  606.             AddChunk(tag, p, len);
  607.         end;
  608.     end;
  609.  
  610.     procedure collection.GetChunkIndex (index: indexType; len: longInt; p: ptr);
  611.         var
  612.             offset, l: longInt;
  613.     begin
  614.         if GetOffset(index, offset, l) then begin
  615.             Assert(l = len);
  616.             BlockMove(ptr(ord(data^) + offset), p, len);
  617.         end;
  618.     end;
  619.  
  620.     procedure collection.GetChunkTag (tag: tagType; len: longInt; p: ptr);
  621.         var
  622.             offset, l: longInt;
  623.             index: indexType;
  624.     begin
  625.         if GetTagOffset(tag, offset, l, index, safeget) then begin
  626.             Assert(l = len);
  627.             BlockMove(ptr(ord(data^) + offset), p, len);
  628.         end
  629.         else begin
  630.             BlockZero(p, len);
  631.         end;
  632.     end;
  633.  
  634.     procedure collection.AddBoolean (b: boolean);
  635.         var
  636.             n: integer;
  637.     begin
  638.         n := -ord(b);
  639.         AddChunk(no_tag, @n, 1);
  640.     end;
  641.  
  642.     procedure collection.AddTagBoolean (tag: univ tagType; b: boolean);
  643.         var
  644.             n: integer;
  645.     begin
  646.         n := -ord(b);
  647.         AddChunk(tag, @n, 1);
  648.     end;
  649.  
  650.     procedure collection.AddLong (n: univ longInt);
  651.     begin
  652.         AddChunk(no_tag, @n, lsize);
  653.     end;
  654.  
  655.     procedure collection.AddTagLong (tag: univ tagType; n: univ longInt);
  656.     begin
  657.         AddChunk(tag, @n, lsize);
  658.     end;
  659.  
  660.     procedure collection.AddString (s: str255);
  661.     begin
  662.         AddChunk(no_tag, @s[1], length(s));
  663.     end;
  664.  
  665.     procedure collection.AddTagString (tag: univ tagType; s: str255);
  666.     begin
  667.         AddChunk(tag, @s[1], length(s));
  668.     end;
  669.  
  670.     procedure collection.AddData (p: ptr; len: longInt);
  671.     begin
  672.         AddChunk(no_tag, p, len);
  673.     end;
  674.  
  675.     procedure collection.AddTagData (tag: univ tagType; p: ptr; len: longInt);
  676.     begin
  677.         AddChunk(tag, p, len);
  678.     end;
  679.  
  680.     procedure collection.AddItem (p: ptr);
  681.     begin
  682.         AddChunk(no_tag, p, size);
  683.     end;
  684.  
  685.     procedure collection.AddTagItem (tag: univ tagType; p: ptr);
  686.     begin
  687.         AddChunk(tag, p, size);
  688.     end;
  689.  
  690.     procedure collection.SetBoolean (index: indexType; b: boolean);
  691.         var
  692.             n: integer;
  693.     begin
  694.         n := -ord(b);
  695.         SetChunkIndex(index, @n, 1);
  696.     end;
  697.  
  698.     procedure collection.SetTagBoolean (tag: univ tagType; b: boolean);
  699.         var
  700.             n: integer;
  701.     begin
  702.         n := -ord(b);
  703.         SetChunkTag(tag, @n, 1);
  704.     end;
  705.  
  706.     procedure collection.SetLong (index: indexType; n: univ longInt);
  707.     begin
  708.         SetChunkIndex(index, @n, lsize);
  709.     end;
  710.  
  711.     procedure collection.SetTagLong (tag: univ tagType; n: univ longInt);
  712.     begin
  713.         SetChunkTag(tag, @n, lsize);
  714.     end;
  715.  
  716.     procedure collection.SetString (index: indexType; s: str255);
  717.     begin
  718.         SetChunkIndex(index, @s[1], length(s));
  719.     end;
  720.  
  721.     procedure collection.SetTagString (tag: univ tagType; s: str255);
  722.     begin
  723.         SetChunkTag(tag, @s[1], length(s));
  724.     end;
  725.  
  726.     procedure collection.SetData (index: indexType; p: ptr; len: longInt);
  727.     begin
  728.         SetChunkIndex(index, p, len);
  729.     end;
  730.  
  731.     procedure collection.SetTagData (tag: univ tagType; p: ptr; len: longInt);
  732.     begin
  733.         SetChunkTag(tag, p, len);
  734.     end;
  735.  
  736.     procedure collection.SetItem (index: indexType; p: ptr);
  737.     begin
  738.         SetChunkIndex(index, p, size);
  739.     end;
  740.  
  741.     procedure collection.SetTagItem (tag: univ tagType; p: ptr);
  742.     begin
  743.         SetChunkTag(tag, p, size);
  744.     end;
  745.  
  746.     function collection.GetBoolean (index: indexType): boolean;
  747.         var
  748.             n: integer;
  749.     begin
  750.         n := 0;
  751.         GetChunkIndex(index, 1, @n);
  752.         GetBoolean := n <> 0;
  753.     end;
  754.  
  755.     function collection.GetTagBoolean (tag: univ tagType): boolean;
  756.         var
  757.             n: integer;
  758.     begin
  759.         n := 0;
  760.         GetChunkTag(tag, 1, @n);
  761.         GetTagBoolean := n <> 0;
  762.     end;
  763.  
  764.     procedure collection.GetLong (index: indexType; var l: univ longInt);
  765.     begin
  766.         GetChunkIndex(index, 4, @l);
  767.     end;
  768.  
  769.     procedure collection.GetTagLong (tag: univ tagType; var l: univ longInt);
  770.     begin
  771.         GetChunkTag(tag, 4, @l);
  772.     end;
  773.  
  774.     function collection.GetString (index: indexType): str255;
  775.         var
  776.             offset, l: longInt;
  777.             s: str255;
  778.     begin
  779.         s := '';
  780.         if GetOffset(index, offset, l) then begin
  781.             Assert(l <= 255);
  782.             BlockMove(ptr(ord(data^) + offset), @s[1], l);
  783.             s[0] := chr(l);
  784.         end;
  785.         GetString := s;
  786.     end;
  787.  
  788.     function collection.GetTagString (tag: univ tagType): str255;
  789.         var
  790.             offset, l: longInt;
  791.             index: indexType;
  792.             s: str255;
  793.     begin
  794.         s := '';
  795.         if GetTagOffset(tag, offset, l, index, safeget) then begin
  796.             Assert(l <= 255);
  797.             BlockMove(ptr(ord(data^) + offset), @s[1], l);
  798.             s[0] := chr(l);
  799.         end;
  800.         GetTagString := s;
  801.     end;
  802.  
  803.     procedure collection.GetData (index: indexType; p: ptr; len: longInt);
  804.     begin
  805.         GetChunkIndex(index, len, p);
  806.     end;
  807.  
  808.     procedure collection.GetTagData (tag: univ tagType; p: ptr; len: longInt);
  809.     begin
  810.         GetChunkTag(tag, len, p);
  811.     end;
  812.  
  813.     procedure collection.GetItem (index: indexType; p: ptr);
  814.     begin
  815.         GetChunkIndex(index, size, p);
  816.     end;
  817.  
  818.     procedure collection.GetTagItem (tag: univ tagType; p: ptr);
  819.     begin
  820.         GetChunkTag(tag, size, p);
  821.     end;
  822.  
  823. end.